{-# OPTIONS -Wall #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  DirectoryScript.Tools.DiffTop
-- Copyright   :  (c) Stephen Peter Tetley 2012
-- License     :  BSD3
--
-- Maintainer  :  stephen.tetley@gmail.com
-- Stability   :  experimental
-- Portability :  to be determined
--
-- /Flat/ syntax - no nesting.
--
-----------------------------------------------------------------------------


module Main where


import DirectoryScript.Lib.Base
import qualified DirectoryScript.Lib.ResolvedSyntax as R
import DirectoryScript.Lib.WindowsParser

import DirectoryScript.Tools.VersionNumbers

import Text.ZFormat


import Data.Set ( (\\) )
import qualified Data.Set as S

import System.Environment
import System.Exit
import System.Console.GetOpt


data Flag = Usage
  deriving (Eq, Show)

header :: String 
header = unlines $ 
    [ "Usage: dirdiff.exe <primary_listing_file> <secondary_listing_file>"
    , ""
    , "Works on listings collected by |> dir /s <| and not directly"
    , "on the file system."
    , "Version number: " ++ versionString3 difftop_version
    ]


options :: [OptDescr Flag]
options =
    [ Option ['h'] ["help"]     (NoArg Usage)        "show this help"
    ]

main :: IO ()
main = do{ args <- getArgs
         ; let (opts, nonopts, errs) = getOpt Permute options args
         ; main2 opts nonopts errs
         }

main2 :: [Flag] -> [FilePath] -> [String] -> IO ()
main2 opts [prime, secon] [] 
  | Usage       `elem` opts = putStrLn $ usageInfo header options
  | otherwise               = action1 prime secon
  
main2  _ _ errors = putStrLn (concat errors ++ usageInfo header options)




action1 :: FilePath -> FilePath -> IO ()
action1 prime secon = do 
    old <- directoriesFromFile prime >>= trapLeft >>= (trapLeft . R.makeResolved)
    new <- directoriesFromFile secon >>= trapLeft >>= (trapLeft . R.makeResolved)
    putStrLn $ show $ title old new
    putStrLn $ show $ reportDirDiffs  old new
    putStrLn $ show $ reportFileDiffs old new
  where
    trapLeft (Left err)  = do { putStrLn err; exitWith (ExitFailure 1) }
    trapLeft (Right ans) = return ans
 


data Directory = Directory { directory_path :: FilePath }
  deriving (Eq,Ord,Show)


data File = File 
     { file_path :: FilePath
     , file_time :: DateTime
     , file_size :: Integer
     }
  deriving (Eq,Ord,Show)

--
-- NOTE - There is no general notion of /moved/ as we have no 
-- clear notion of the identity of a directory or file.
-- (There is no access to the inode number in Windows directory
-- listings). 
--
-- Instead we have user supplied heuristics to identify 
-- anticipated changes to the file system structure.
--


-- | returns (exclusive_old, intersection, exclusive_new)
--
dirSets :: R.Resolved -> R.Resolved 
        -> (S.Set Directory, S.Set Directory, S.Set Directory)
dirSets oldr newr = 
    (olds \\ news, olds `S.intersection` news, news \\ olds)
  where
    olds = S.fromList $ map mkDir $ R.res_directories oldr
    news = S.fromList $ map mkDir $ R.res_directories newr

    mkDir = Directory . R.dir_path_from_root



fileSets :: R.Resolved -> R.Resolved 
         -> (S.Set File, S.Set File, S.Set FilePath, S.Set File)
fileSets oldr newr = 
    (dels, sames, mod_names, adds)
  where
    olds = S.fromList $ map mkFile $ R.res_files oldr
    news = S.fromList $ map mkFile $ R.res_files newr

    dels0     = olds \\ news
    adds0     = news \\ olds
    sames     = olds `S.intersection` news

    del_names = S.map file_path dels0
    add_names = S.map file_path adds0

    mod_names = del_names `S.intersection` add_names

    dels = S.filter (\a -> not $ S.member (file_path a) mod_names) dels0
    adds = S.filter (\a -> not $ S.member (file_path a) mod_names) adds0

    mkFile a = File { file_path = R.file_path_from_root a
                    , file_time = R.file_datetime a
                    , file_size = R.file_size a
                    }




--------------------------------------------------------------------------------
-- Report


title :: R.Resolved -> R.Resolved -> Doc
title old new = vcat $ 
    [ underline $ text "difftop" <+> text version_string <+> text "- comparing:"
    , blank
    , underline $ text "Old:"
    , text (R.res_path_to_root old)
    , ppDateTime (R.resolvedDateTime old)
    , countLine (length $ R.res_directories old) (length $ R.res_files old)
    , blank
    , underline $ text "New:"
    , text (R.res_path_to_root new)
    , ppDateTime (R.resolvedDateTime new)
    , countLine (length $ R.res_directories new) (length $ R.res_files new)
    , blank
    ]
  where
    version_string = versionString3 difftop_version

    countLine = \i j -> int i <+> text "directories, " <+> int j <+> text "files."



reportDirDiffs :: R.Resolved -> R.Resolved -> Doc
reportDirDiffs old new = vcat
    [ underline $ text "Directory changes"
    , blank
    , text "Deleted:"
    , int (S.size dels) <+> text "directories deleted."
    , indent 2 $ vcat $ map (text . directory_path) $ S.elems dels
    , blank
    , text "Added:"
    , int (S.size adds) <+> text "directories added."
    , indent 2 $ vcat $ map (text . directory_path) $ S.elems adds
    , blank
    , int (S.size sames) <+> text "directories untouched."
    , blank
    ]
  where
    (dels,sames,adds) = dirSets old new


reportFileDiffs :: R.Resolved -> R.Resolved -> Doc
reportFileDiffs old new = vcat
    [ underline $ text "File changes"
    , blank
    , text "Deleted:"
    , int (S.size dels) <+> text "files deleted."
    , indent 2 $ vcat $ map (text . file_path) $ S.elems dels
    , blank
    , text "Added:"
    , int (S.size adds) <+> text "files added."
    , indent 2 $ vcat $ map (text . file_path) $ S.elems adds
    , blank
    , text "Modified:"
    , int (S.size mods) <+> text "files modified."
    , indent 2 $ vcat $ map text $ S.elems mods
    , blank
    , int (S.size sames) <+> text "files untouched."
    , blank
    ]
  where
    (dels,sames,mods,adds) = fileSets old new


ppFile :: File -> Doc
ppFile a = text (file_path a) <+> ppDateTime (file_time a)